home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / network.swg / 0023_Netware Encrypted Login.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-24  |  14.1 KB  |  634 lines
  1.  
  2. {$R+,V-}
  3.  
  4. { This program will prompt for a server, login id and password.  All }
  5. { input will be echoed to the screen!                                }
  6.  
  7. PROGRAM LOGON;
  8.  
  9. USES
  10.   Dos,
  11.   Crt;
  12.  
  13. CONST
  14.   NET_USER         = 1;
  15.   USER_GROUP       = 2;
  16.   FILE_SERVER      = 4;
  17.  
  18.   MaxServers       = 8;
  19.   DriveHandleTable = 0;
  20.   DriveFlagTable   = 1;
  21.   DriveServerTable = 2;
  22.   ServerMapTable   = 3;
  23.   ServerNameTable  = 4;
  24.  
  25. TYPE
  26.   Buf32 = ARRAY [0..31] OF BYTE;
  27.   Buf16 = ARRAY [0..15] OF BYTE;
  28.   Buf8  = ARRAY [0..7]  OF BYTE;
  29.   Buf4  = ARRAY [0..3]  OF BYTE;
  30.  
  31. CONST
  32.   EncryptTable : ARRAY [BYTE] OF BYTE =
  33. ($7,$8,$0,$8,$6,$4,$E,$4,$5,$C,$1,$7,$B,$F,$A,$8,
  34.  $F,$8,$C,$C,$9,$4,$1,$E,$4,$6,$2,$4,$0,$A,$B,$9,
  35.  $2,$F,$B,$1,$D,$2,$1,$9,$5,$E,$7,$0,$0,$2,$6,$6,
  36.  $0,$7,$3,$8,$2,$9,$3,$F,$7,$F,$C,$F,$6,$4,$A,$0,
  37.  $2,$3,$A,$B,$D,$8,$3,$A,$1,$7,$C,$F,$1,$8,$9,$D,
  38.  $9,$1,$9,$4,$E,$4,$C,$5,$5,$C,$8,$B,$2,$3,$9,$E,
  39.  $7,$7,$6,$9,$E,$F,$C,$8,$D,$1,$A,$6,$E,$D,$0,$7,
  40.  $7,$A,$0,$1,$F,$5,$4,$B,$7,$B,$E,$C,$9,$5,$D,$1,
  41.  $B,$D,$1,$3,$5,$D,$E,$6,$3,$0,$B,$B,$F,$3,$6,$4,
  42.  $9,$D,$A,$3,$1,$4,$9,$4,$8,$3,$B,$E,$5,$0,$5,$2,
  43.  $C,$B,$D,$5,$D,$5,$D,$2,$D,$9,$A,$C,$A,$0,$B,$3,
  44.  $5,$3,$6,$9,$5,$1,$E,$E,$0,$E,$8,$2,$D,$2,$2,$0,
  45.  $4,$F,$8,$5,$9,$6,$8,$6,$B,$A,$B,$F,$0,$7,$2,$8,
  46.  $C,$7,$3,$A,$1,$4,$2,$5,$F,$7,$A,$C,$E,$5,$9,$3,
  47.  $E,$7,$1,$2,$E,$1,$F,$4,$A,$6,$C,$6,$F,$4,$3,$0,
  48.  $C,$0,$3,$6,$F,$8,$7,$B,$2,$D,$C,$6,$A,$A,$8,$D);
  49.  
  50.   EncryptKeys : Buf32 =
  51. ($48,$93,$46,$67,$98,$3D,$E6,$8D,$B7,$10,$7A,$26,$5A,$B9,$B1,$35,
  52.  $6B,$0F,$D5,$70,$AE,$FB,$AD,$11,$F4,$47,$DC,$A7,$EC,$CF,$50,$C0);
  53.  
  54.  
  55. TYPE
  56.   WORD   = INTEGER;
  57.  
  58.   NetStr = STRING[47];
  59.   GenStr = STRING[128];
  60.   FourBytes = ARRAY [1..4] of BYTE;
  61.   MemBlock = ARRAY [1..128] OF CHAR;
  62.  
  63. {  RegsType = RECORD case integer of
  64.     1: (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : INTEGER);
  65.     2: (AL, AH, BL, BH, CL, CH, DL, DH            : BYTE);
  66.     END; }
  67.  
  68.   ServerItem = ARRAY [1..48] OF CHAR;
  69.   ServerName = ARRAY[1..MaxServers] OF ServerItem;
  70.   ServerNamePtr = ^ServerName;
  71.  
  72.   ServerMappingEntry = RECORD
  73.     SlotInUse      : BYTE;
  74.     OrderNumber    : BYTE;
  75.     ServerNet      : ARRAY [1..10] OF CHAR;
  76.     ServerSocket   : WORD;
  77.     RouterNet      : ARRAY [1..10] OF CHAR;
  78.     RouterSocket   : WORD;
  79.     ShellInternal  : ARRAY [1..6] OF CHAR;
  80.   END;
  81.  
  82.   ServerMappingTable = ARRAY [1..MaxServers] OF ServerMappingEntry;
  83.   ServerMappingPtr   = ^ServerMappingTable;
  84.  
  85. VAR
  86.   rc   : BYTE;
  87.   Regs : Registers;
  88.   { Regs : RegsType; }
  89.  
  90. { -------------------------------------------------------------- }
  91.  
  92. FUNCTION GetString(VAR NameEntry: ServerItem): GenStr;
  93. VAR   tmp: GenStr;
  94.       i:   INTEGER;
  95.       ct:  BYTE;
  96. BEGIN
  97.   i  := 1;
  98.   ct := 0;
  99.  
  100.   WHILE NameEntry[i] <> CHR(0) DO
  101.      BEGIN
  102.        tmp[i] := NameEntry[i];
  103.        i  := i  + 1;
  104.        ct := ct + 1;
  105.        END;
  106.  
  107.   tmp[0] := CHAR(ct);
  108.   GetString := tmp;
  109.   END;
  110.  
  111. PROCEDURE Str2Az(st: GenStr; VAR az; size: INTEGER);
  112. VAR  p: ^BYTE;
  113. BEGIN
  114.   Fillchar(az, size+1, 0);
  115.   p := ADDR(st[1]);
  116.   Move(p^, az, size);
  117.   END;
  118.  
  119. PROCEDURE DefaultRegs(VAR r: Registers);
  120. BEGIN
  121.   r.DS := DSeg;
  122.   r.ES := DSeg;
  123. { r.AX := 0;
  124.   r.BX := 0;
  125.   r.CX := 0;
  126.   r.DX := 0;
  127.   r.BP := 0;
  128.   r.SI := 0;
  129.   r.DI := 0; }
  130.   END;
  131.  
  132. FUNCTION FileServiceRequest( func:            BYTE;
  133.                              VAR q; qlen:     WORD;
  134.                              VAR reply; rlen: WORD): BYTE;
  135. BEGIN
  136.   DefaultRegs(Regs);
  137.   Regs.DS := Seg(q);
  138.   Regs.SI := Ofs(q);
  139.   Regs.CX := qlen;
  140.   Regs.ES := Seg(reply);
  141.   Regs.DI := Ofs(reply);
  142.   Regs.DX := rlen;
  143.   Regs.AH := $F2;
  144.   Regs.AL := func;
  145.   MSDOS(Regs);
  146.   FileServiceRequest := Regs.AL;
  147. END;
  148.  
  149. FUNCTION CallNetware(RegAH : BYTE; VAR request, reply): BYTE;
  150. BEGIN
  151.   DefaultRegs(Regs);
  152.   Regs.AH := RegAH;
  153.   Regs.DS := Seg(request);
  154.   Regs.SI := Ofs(request);
  155.   Regs.ES := Seg(reply);
  156.   Regs.DI := Ofs(reply);
  157.   MSDOS(Regs);
  158.   CallNetware := Regs.AL;
  159.   END;
  160.  
  161. PROCEDURE UpcaseStr(VAR s: GenStr);
  162. VAR  i : INTEGER;
  163. BEGIN
  164.   for i := 1 to Length(s) do
  165.     Begin
  166.     s[i] := UpCase(s[i]);
  167.     End;
  168.   END;
  169.  
  170. FUNCTION GetServerMappingPtr : ServerMappingPtr;
  171. VAR TmpPtr: ServerMappingPtr;
  172. BEGIN
  173.   DefaultRegs(Regs);
  174.   Regs.AX := $EF03;
  175.   MSDOS(Regs);
  176.   TmpPtr  := Ptr(Regs.ES, Regs.SI);
  177.   GetServerMappingPtr := TmpPtr;
  178.   END;
  179.  
  180. FUNCTION GetServerNamePtr : ServerNamePtr;
  181. VAR TmpPtr: ServerNamePtr;
  182. BEGIN
  183.   DefaultRegs(Regs);
  184.   Regs.AX := $EF04;
  185.   MSDOS(Regs);
  186.   TmpPtr  := Ptr(Regs.ES, Regs.SI);
  187.   GetServerNamePtr := TmpPtr;
  188.   END;
  189.  
  190. FUNCTION GetServerNumber(s: NetStr): BYTE;
  191. VAR
  192.   t : ServerNamePtr;
  193.   m : ServerMappingPtr;
  194.   i : INTEGER;
  195. BEGIN
  196.   m := GetServerMappingPtr;
  197.   t := GetServerNamePtr;
  198.   UpCaseStr(s);
  199.  
  200.   FOR i:=1 TO MaxServers DO BEGIN
  201.     IF (m^[i].SlotInUse = $FF) AND (GetString(t^[i]) = s) THEN BEGIN
  202.       GetServerNumber := i;
  203.       Exit;
  204.     END;
  205.   END;
  206.   GetServerNumber := 0;
  207. END;
  208.  
  209. FUNCTION ReadPropertyValue(ObjectType : WORD; ObjectName : NetStr;
  210.                         Segnr : BYTE; Property : NetStr;
  211.                         VAR item): BYTE;
  212. VAR
  213.   req : RECORD
  214.     plen : WORD;
  215.     func : BYTE;
  216.     otype : WORD;
  217.     Filler : GenStr;
  218.   END;
  219.   rep : RECORD
  220.     plen : WORD;
  221.     Data : ARRAY [1..128] OF BYTE;
  222.     More : BYTE;
  223.     PropFlags : BYTE;
  224.   END;
  225.  
  226. BEGIN
  227.   req.func := 61;
  228.   req.otype := Swap(ObjectType);
  229.   req.plen := Length(ObjectName) +
  230.               Length(Property) + 6;
  231.   req.filler := ObjectName + Char(Segnr) +
  232.                 Char(Length(Property)) +
  233.                 Property;
  234.   req.filler[0] := Char(Length(ObjectName));
  235.   rep.plen := SizeOf(rep) - 2;
  236.   ReadPropertyValue := CallNetware($E3,req,rep);
  237.   Move(rep.data, item, SizeOf(rep.data) + 2);
  238. END;
  239.  
  240. FUNCTION InsertServer(Name : NetStr):BYTE;
  241. VAR
  242.   MapPtr  : ServerMappingPtr;
  243.   NamePtr : ServerNamePtr;
  244.   res     : BYTE;
  245.   free,i  : INTEGER;
  246.   data    : ARRAY [1..130] OF BYTE;
  247.  
  248.   FUNCTION LowerAddr(VAR a, b): BOOLEAN;
  249.   TYPE
  250.     Net_Address = ARRAY [1..10] OF CHAR;
  251.   VAR
  252.     a_addr : Net_Address ABSOLUTE a;
  253.     b_addr : Net_Address ABSOLUTE b;
  254.   BEGIN
  255.     LowerAddr := a_addr < b_addr;
  256.   END;
  257.  
  258. BEGIN
  259.   UpCaseStr(Name);
  260.   IF GetServerNumber(Name) <> 0 THEN BEGIN
  261.     InsertServer := 0;
  262.     Exit;
  263.   END;
  264.  
  265.   res := ReadPropertyValue(FILE_SERVER, name, 1, 'NET_ADDRESS', data);
  266.   IF res <> 0 THEN BEGIN
  267.     InsertServer := $7D;
  268.     Exit;
  269.   END;
  270.  
  271.   MapPtr := GetServerMappingPtr;
  272.   free := 1;
  273.   WHILE (MapPtr^[free].SlotInUse = $FF) DO BEGIN
  274.     free := free + 1;
  275.     IF free > MaxServers THEN BEGIN
  276.       InsertServer := $7C;
  277.       Exit;
  278.     END;
  279.   END;
  280.  
  281.   NamePtr := GetServerNamePtr;
  282.   WITH MapPtr^[free] DO BEGIN
  283.     Move(data, ServerNet, 12);
  284.     Str2Az(name, NamePtr^[free], SizeOf(NamePtr^[free]));
  285.     OrderNumber := 1;
  286.     FOR i := 1 TO MaxServers DO BEGIN
  287.       IF MapPtr^[i].SlotInUse = $FF THEN BEGIN
  288.         IF LowerAddr(MapPtr^[i].ServerNet, ServerNet) THEN
  289.           OrderNumber := OrderNumber + 1
  290.         ELSE
  291.           MapPtr^[i].OrderNumber := MapPtr^[i].OrderNumber + 1;
  292.       END;
  293.     END;
  294.     SlotInUse := $FF;
  295.   END;
  296.   InsertServer := 0;
  297. END;
  298.  
  299. FUNCTION AttachServerNumber(func : BYTE; sn : BYTE) : BYTE;
  300. BEGIN
  301.   DefaultRegs(Regs);
  302.   Regs.ah := $F1;
  303.   Regs.al := func;
  304.   Regs.dl := sn;
  305.   MSDOS(Regs);
  306.   AttachServerNumber := Regs.al;
  307. END;
  308.  
  309. FUNCTION AttachServer(func : BYTE; name : NetStr) : BYTE;
  310. VAR
  311.   sn : BYTE;
  312. BEGIN
  313.   sn := GetServerNumber(name);
  314.   IF sn = 0 THEN BEGIN
  315.     AttachServer := $7B;
  316.     Exit;
  317.   END;
  318.   AttachServer := AttachServerNumber(func,sn);
  319. END;
  320.  
  321.  
  322. FUNCTION GetEffectiveServer:BYTE;
  323. BEGIN
  324.   DefaultRegs(Regs);
  325.   Regs.ax := $F002;
  326.   MSDOS(Regs);
  327.   GetEffectiveServer := Regs.al;
  328. END;
  329.  
  330. PROCEDURE SetPrimaryServer(sno:BYTE);
  331. BEGIN
  332.   DefaultRegs(Regs);
  333.   Regs.ax := $F004;
  334.   Regs.dl := sno;
  335.   MSDOS(Regs);
  336. END;
  337.  
  338. FUNCTION GetPrimaryServer:BYTE;
  339. BEGIN
  340.   DefaultRegs(Regs);
  341.   Regs.ax := $F005;
  342.   MSDOS(Regs);
  343.   GetPrimaryServer := Regs.al;
  344. END;
  345.  
  346. FUNCTION SetPreferredServer(sno: BYTE): BYTE;
  347. BEGIN
  348.   DefaultRegs(Regs);
  349.   Regs.ax := $F000;
  350.   Regs.dl := sno;
  351.   MSDOS(Regs);
  352.   Regs.ax := $F001;
  353.   MSDOS(Regs);
  354.   SetPreferredServer := Regs.AL;
  355. END;
  356.  
  357. FUNCTION MapNameToNumber(ObjectType : WORD;ObjectName : NetStr;
  358.                          VAR ObjectID : FourBytes): BYTE;
  359. VAR
  360.   req : RECORD
  361.     plen : WORD;
  362.     func : BYTE;
  363.     otype : WORD;
  364.     name : NetStr;
  365.   END;
  366.   rep : RECORD
  367.     plen : WORD;
  368.     objID : FourBytes;
  369.     otype : WORD;
  370.     name : ARRAY [1..48] OF CHAR;
  371.   END;
  372. BEGIN
  373.   req.func := 53;      {Get an object's number}
  374.   req.otype := Swap(ObjectType);
  375.   req.name := ObjectName;
  376.   req.plen := Length(ObjectName) + 4;
  377.   rep.plen := SizeOf(rep) - 2;
  378.   MapNameToNumber := CallNetware($E3, req, rep);
  379.   ObjectID := rep.objID;
  380. END;
  381.  
  382. FUNCTION MapNumberToName(ID : FourBytes; VAR Name; VAR Otype : WORD):BYTE;
  383. VAR
  384.   req : RECORD
  385.     plen : WORD;
  386.     func : BYTE;
  387.     OID  : FourBytes;
  388.   END;
  389.   rep : RECORD
  390.     plen  : WORD;
  391.     OID   : FourBytes;
  392.     otyp  : WORD;
  393.     Oname : ServerItem;
  394.   END;
  395.   nam : NetStr ABSOLUTE Name;
  396. BEGIN
  397.   req.func := 54;      {Get an object's name}
  398.   req.OID := ID;
  399.   req.plen := SizeOf(req) - 2;
  400.   rep.plen := SizeOf(rep) - 2;
  401.   MapNumberToName := CallNetware($E3,req,rep);
  402.   Nam := GetString(rep.OName);
  403.   Otype:= Swap(rep.Otyp);
  404. END;
  405.  
  406. FUNCTION LoginAnObject( Name:NetStr; Otype:WORD; Passw: NetStr):BYTE;
  407. VAR
  408.   req : RECORD
  409.     plen : WORD;
  410.     func : BYTE;
  411.     otype : WORD;
  412.     NamePass : STRING[96];
  413.   END;
  414.   rep : RECORD
  415.     plen : WORD;
  416.   END;
  417. BEGIN
  418.   req.plen := 5 + Length(Name) + Length(Passw);
  419.   req.func := 20;
  420.   UpCaseStr(Passw);
  421.   UpCaseStr(Name);
  422.   req.otype := Swap(otype);
  423.   req.NamePass:=Name;
  424.   Move(Passw, req.NamePass[Length(Name)+1], Length(Passw) + 1);
  425.   rep.plen := 0;
  426.   LoginAnObject := CallNetware($E3, req, rep);
  427. END;
  428.  
  429. FUNCTION LoginUser(Name, Password: NetStr): BYTE;
  430. VAR
  431.   req : RECORD
  432.     plen : INTEGER;
  433.     func : BYTE;
  434.     NamePass : STRING[96];
  435.   END;
  436.   rep : RECORD
  437.     plen : INTEGER;
  438.   END;
  439.  
  440. BEGIN
  441.   req.plen := 3 + Length(Name) + Length(Password);
  442.   req.func := 0;
  443.   UpcaseStr(Password);
  444.   UpcaseStr(Name);
  445.   req.NamePass := Name;
  446.   Move(Password, req.NamePass[Length(Name)+1], Length(Password)+1);
  447.   rep.plen := 0;
  448.   LoginUser := CallNetware($E3, req, rep);
  449. END;
  450.  
  451. FUNCTION GetEncryptionKey(VAR key : Buf8): BYTE;
  452. VAR
  453.   q : RECORD
  454.     plen : WORD;
  455.     func : BYTE;
  456.   END;
  457. BEGIN
  458.   q.plen := 1;
  459.   q.func := $17;
  460.   GetEncryptionKey := FileServiceRequest($17, q, SizeOf(q), key, SizeOf(key));
  461. END;
  462.  
  463. FUNCTION LoginEncrypted(name : NetStr; otype : WORD; VAR key : Buf8): BYTE;
  464. VAR
  465.   a : RECORD
  466.     plen : WORD;
  467.     func : BYTE;
  468.     key  : Buf8;
  469.     otyp : WORD;
  470.     name : NetStr;
  471.   END;
  472. BEGIN
  473.   a.plen := Length(name) + 12;
  474.   a.func := $18;
  475.   a.key  := key;
  476.   a.otyp := Swap(otype);
  477.   a.name := name;
  478.   LoginEncrypted := FileServiceRequest($17, a, Length(name)+14, Mem[0:0], 0);
  479. END;
  480.  
  481. PROCEDURE Shuffle1(VAR temp : Buf32; VAR target);
  482. VAR
  483.   t  :  Buf16 ABSOLUTE target;
  484.   b4 :  WORD;
  485.   b3 :  BYTE;
  486.   s, d, b2, i : WORD;
  487. BEGIN
  488.   b4 := 0;
  489.   FOR b2 := 0 TO 1 DO BEGIN
  490.     FOR s := 0 TO 31 DO BEGIN
  491.       b3 := Lo(Lo(temp[s] + b4)
  492.             XOR Lo(temp[(s + b4) AND 31]
  493.           - EncryptKeys[s]));
  494.       b4 := b4 + b3;
  495.       temp[s] := b3;
  496.     END;
  497.   END;
  498.  
  499.   FOR i := 0 TO 15 DO
  500.     t[i] := EncryptTable[temp[i Shl 1]]
  501.         OR (EncryptTable[temp[i Shl 1 +1]] Shl 4);
  502. END;
  503.  
  504. PROCEDURE Shuffle(VAR lon, buf; buflen : WORD; VAR target);
  505. VAR
  506.   l : Buf4 ABSOLUTE lon;
  507.   b : ARRAY [0..127] OF BYTE ABSOLUTE buf;
  508.   b2 : WORD;
  509.   temp : Buf32;
  510.   s, d : WORD;
  511. BEGIN
  512.   IF buflen > 0 THEN
  513.      WHILE (buflen > 0) AND (b[buflen-1] = 0) DO
  514.        buflen := buflen - 1;
  515.  
  516.   FillChar(temp, SizeOf(temp), #0);
  517.  
  518.   d := 0;
  519.   WHILE buflen >= 32 DO BEGIN
  520.     FOR s := 0 TO 31 DO BEGIN
  521.       temp[s] := temp[s] XOR b[d];
  522.       d := d + 1;
  523.     END;
  524.     buflen := buflen - 32;
  525.   END;
  526.   b2 := d;
  527.  
  528.   IF buflen > 0 THEN BEGIN
  529.     FOR s := 0 TO 31 DO BEGIN
  530.       IF d + buflen = b2 THEN BEGIN
  531.         b2 := d;
  532.         temp[s] := temp[s] XOR EncryptKeys[s];
  533.       END
  534.       ELSE BEGIN
  535.         temp[s] := temp[s] XOR b[b2];
  536.         b2 := b2 + 1;
  537.       END;
  538.     END;
  539.   END;
  540.   FOR s := 0 TO 31 DO
  541.     temp[s] := temp[s] XOR l[s AND 3];
  542.  
  543.   Shuffle1(temp, target);
  544. END;
  545.  
  546. PROCEDURE Encrypt(VAR fra, buf, til);
  547. VAR
  548.   f : Buf8  ABSOLUTE fra;
  549.   t : Buf8  ABSOLUTE til;
  550.   k : Buf32;
  551.   s : WORD;
  552. BEGIN
  553.   Shuffle(f[0], buf, 16, k[0]);
  554.   Shuffle(f[4], buf, 16, k[16]);
  555.   FOR s := 0 TO 15 DO
  556.     k[s] := k[s] XOR k[31-s];
  557.   FOR s := 0 TO 7 DO
  558.     t[s] := k[s] XOR k[15-s];
  559. END;
  560.  
  561. FUNCTION LoginToFileServer(name: NetStr; otype: WORD; passw: GenStr): BYTE;
  562. VAR
  563.   key : Buf8;
  564.   id  : FourBytes;
  565.   buf : Buf32;
  566.   res : BYTE;
  567.  
  568. BEGIN
  569.   UpCaseStr(passw);
  570.   res := GetEncryptionKey(key);
  571.   IF res = 0 THEN BEGIN
  572.     res := MapNameToNumber(otype, name, id);
  573.     IF res = 0 THEN BEGIN
  574.       Shuffle(id, passw[1], Length(passw), buf);
  575.       Encrypt(key, buf, key);
  576.       res := LoginEncrypted(name, otype, key);
  577.     END;
  578.   END
  579.   ELSE BEGIN
  580.     res := LoginAnObject(name, otype, passw);
  581.     END;
  582.  
  583.   LoginToFileServer := res;
  584. END;
  585.  
  586. FUNCTION Login(Sname, OName : NetStr; OType : WORD; Passw : NetStr) : BYTE;
  587. VAR
  588.   sn, res, rc : BYTE;
  589.   Curr_Server : BYTE;
  590. BEGIN
  591.   UpCaseStr(SName);
  592.   sn := GetServerNumber(Sname);
  593.  
  594.   IF sn = 0 THEN BEGIN
  595.     res := InsertServer(SName);
  596.     IF res <> 0 THEN BEGIN
  597.       Login := res;
  598.       Exit;
  599.     END;
  600.     sn := GetServerNumber(SName);
  601.   END;
  602.  
  603.   res := AttachServerNumber(0, sn);
  604.   IF res <> 0 THEN BEGIN
  605.     Login := res;
  606.     Exit;
  607.   END;
  608.  
  609.   Curr_Server := GetEffectiveServer;
  610.   IF SetPreferredServer(sn) = sn THEN
  611.     rc := LoginToFileServer(OName, Otype, Passw)
  612.   ELSE
  613.     rc := $7A;
  614.  
  615.   res := SetPreferredServer(Curr_Server);
  616.   Login := rc;
  617. END;
  618.  
  619. BEGIN
  620.   IF ParamCount <> 3 THEN BEGIN
  621.      Writeln('Please supply server name, your user id, and a password.');
  622.      Exit;
  623.      END;
  624.  
  625.   rc := Login(ParamStr(1), ParamStr(2), NET_USER, ParamStr(3));
  626.  
  627.   IF rc <> 0 THEN BEGIN
  628.      Writeln('Login failed.');
  629.      Exit;
  630.      END;
  631.  
  632.   END.
  633.  
  634.